TreeView樹狀圖結構物件雖然存在於Access 中,但並沒有太詳細的說明,筆者到最近才開始嘗試使用,個人感覺設計上並不太友善,但還是有一定的使用效果。
筆者參考了Stephen Hill撰寫的教程,一步步進行編寫,使用現有的資料來產生樹狀圖,可以有更視覺化呈現。
程式呈現如下圖:
「讀取/篩選」按鈕的程式如下:
Private Sub cmd_Search_Click()
xMyTreeview.nodes.Clear
SetUpImageList
SetUpContextMenu
AddAllNodes
End Sub
Private Sub SetUpImageList()
Dim strFolder As String
' retreive the database's folder as the folder for the images
'strFolder = CurrentProject.Path & "\"
strFolder = "D:\temp\vba\"
With Me.xMyTreeviewImages
With .ListImages
.Clear
' load images to image list, specifying a key that will be used to connect the image
' to the nodes later on
' each image has to be converted to picture data using LoadPicture()
' Customer and Order nodes will use a picture appropriate to the type of node
.Add key:="Customer", Picture:=LoadPicture(strFolder & "Customer.bmp")
.Add key:="Order", Picture:=LoadPicture(strFolder & "Order.bmp")
' Order line nodes will use an image that relates to the product's category, keyed
' using the category's name
.Add key:="Beverages", Picture:=LoadPicture(strFolder & "Beverages.bmp")
.Add key:="Condiments", Picture:=LoadPicture(strFolder & "Condiments.bmp")
.Add key:="Confections", Picture:=LoadPicture(strFolder & "Confections.bmp")
.Add key:="Dairy Products", Picture:=LoadPicture(strFolder & "Dairy Products.bmp")
.Add key:="Grains/Cereals", Picture:=LoadPicture(strFolder & "Grains.bmp")
.Add key:="Meat/Poultry", Picture:=LoadPicture(strFolder & "Meat.bmp")
.Add key:="Produce", Picture:=LoadPicture(strFolder & "Produce.bmp")
.Add key:="Seafood", Picture:=LoadPicture(strFolder & "Seafood.bmp")
End With
End With
End Sub
Public Sub SetUpContextMenu()
' requires a reference to the Microsoft office object library
On Error Resume Next ' ignore error if command bar does not exist to be deleted
CommandBars("MyTreeviewContextMenu").Delete
On Error GoTo 0
With CommandBars.Add(Name:="MyTreeviewContextMenu", Position:=msoBarPopup)
With .Controls.Add(TYPE:=msoControlButton)
.Caption = "Node Details"
.OnAction = "PopUpNodeDetails"
End With
With .Controls.Add(TYPE:=msoControlButton)
.Caption = "Delete Node"
.OnAction = "PopUpNodeDelete"
End With
End With
End Sub
Private Sub AddAllNodes()
Dim rst As DAO.Recordset ' recordset for category and product data
Dim strCategoryNodeKey ' key for this category node
Dim strProductNodeKey
Dim strOldCategoryKey As String ' for detecting change in category
Dim strOldProductNodeKey As String
If isNothing(Combo_lng) Then
strLng = "CHT"
Else
strLng = Combo_lng
End If
If isNothing(Text_Search) = False Then
strWhere = " WHERE C.NAME_" & strLng & " LIKE '*" & Text_Search & "*' OR CS.NAME_" & strLng & " LIKE '*" & Text_Search & "*' OR I.MARK LIKE '*" & Text_Search & "*' OR I.MODEL LIKE '*" & Text_Search & "*' OR I.TYPE LIKE '*" & Text_Search & "*' OR I.[S/N] LIKE '*" & Text_Search & "*' "
End If
strSQL = "" & _
"SELECT C.INDEX AS CK, C.NAME_" & strLng & " AS CNAME, CS.INDEX AS CSK, CS.NAME_" & strLng & " AS CSNAME, I.INDEX AS IK, I.MARK, I.MODEL, I.TYPE, I.[S/N], I.STATUS_ID " & vbCrLf & _
"FROM (CategoryType AS C LEFT JOIN CategorySubType AS CS ON C.INDEX = CS.CategoryType_INDEX) LEFT JOIN InventoryOfProperty AS I ON CS.INDEX = I.CATEGORY " & vbCrLf & _
strWhere & _
"ORDER BY C.NAME_" & strLng & ", CS.NAME_" & strLng & ", I.MARK, I.MODEL, I.TYPE "
Debug.Print strSQL
' open the recordset
Set rst = CurrentDb.OpenRecordset(strSQL)
' loop through the rows in the recordset
If rst.EOF Then Exit Sub
rst.MoveFirst
Do Until rst.EOF
strCategoryNodeKey = "Cat=" & rst!CK
If strCategoryNodeKey <> strOldCategoryKey Then ' check for change in category
' change in category- add category node
With Me.xMyTreeview.nodes.Add(text:=rst!CNAME, key:=strCategoryNodeKey, Image:="Customer")
.Expanded = True
End With
strOldCategoryKey = strCategoryNodeKey ' remember this as the current key for detecting changes
End If
strProductNodeKey = "Prod=" & rst!CSK
If strCategoryNodeKey & strProductNodeKey <> strOldCategoryKey & strOldProductNodeKey Then ' check for change in category
' change in category- add category node
With Me.xMyTreeview.nodes.Add(Relationship:=tvwChild, Relative:=strCategoryNodeKey, text:=rst!CSName, key:=strProductNodeKey, Image:="Order")
.Expanded = True
End With
strOldProductNodeKey = strProductNodeKey ' remember this as the current key for detecting changes
End If
If IsNull(rst!IK) = False Then
strItemNodeKey = "Item=" & rst!IK
' now add product node
Debug.Print rst![S/N]
With Me.xMyTreeview.nodes.Add(Relationship:=tvwChild, Relative:=strProductNodeKey, _
text:=rst!Mark & "(" & rst!Model & "/" & rst!TYPE & "/" & rst![S/N] & ")", key:=strItemNodeKey, Image:="Confections")
If rst![STATUS_ID] = 1 Or rst![STATUS_ID] = 7 Or rst![STATUS_ID] = 10 Then
.ForeColor = vbGrayText
End If
End With
End If
rst.MoveNext ' next record in qeury
Loop
End Sub
參考網站:
My MS Access Blog
http://MyMSAccessBlog.blogspot.com